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TITLE coaseyr! 7 L Intermediate Exponent of 
SIDENT /1 File: COBEXPI.MAR Edit:LGB1012 
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COPYRIGHT (c) 1978, 1980, 1982, 1984 B 
DIGITAL ot ys eGORPORATION, MAYNARD. MASSACHUSETTS. 
ALL RIGHTS RESER 
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THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
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DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
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-SBTTL HISTORY 3; Detailed current edit history 
Edit history for Version 1 of COBINTARI.MAR 


1-001 - Original. wish input and output multiplexors Lifted from COBINTARI. 
-AUQg- 
1-002 = Changed handling of negative bases. PDG 22-Sep-1979. 
1-38 Rehe routine Pie. RKR 5A Sept e79 
1-004 - poorest Unget ined Exponentiation error code for LIBSSIGNAL 
1-005 - Renoye edd} e tenet NON=-PIC instruction MOVAW 1[ROJ, RO 
RKR 1-O0CT-7 


1-006 = Add gcd tional entry point COBSEXPI_OSE, and minor code improvements 
POG 35-OCT-79 


1-007 = Complete implementation of COBSEXPI_OSE. MLJ 09-Oct-79 
1-008 - Replaced OTS$_FATINTERR signals by TOBS_INVARG. 
Replaced all CIBSSIGNAL ga ls by IBSSTOP calls. 
Cosmetic changes. 21-0CT- 
1-009 = Added checks for outoe farang CIT's. RKR 30-OCT-79 
1-010 = Fix check for exponent overflow and underflow in FINISH. 
suersaces, thet a fraction of zero has an exponent of zero. 


1-011 = Changed the branch to FINISH in routine COBSEXPI at Label 1$: 
to a RET instruction since FINISH expects the input argument 
to be in the proper format, where in this case, the argument is 
in error and therefore it was never put in the format that 
FINISH expects it to be. LB 15-APR-81 

1-012 = Avoid undetected overflow of y in the exponentiate loop by adjusting 
see ; we Sis Also, restore ‘‘begin-loop’’ and ‘'end-Loop’’ comments. 
Prevent a negative base with zero exponent from Getting the error 
COBS_UNDEF_EXP. It should get a result of 1. A negative base 
with an exponent less than gore will continue to correctly get the 
COBS_UNDEF EXP error. LGB 17-AUG-8 
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-SBTTL DECLARATIONS 


-DSABL GBL 


: INCLUDE FILES: 


> EXTERNAL SYMBOLS: 


VT 
~EXTRN COBSCVT 
VT 


T 
~EXTRN COBSCVT 


DECLARATIONS 


-PSECT _COBSCODE 


> EQUATED SYMBOLS: 
INTSP_I_FRACT= 2 


; OWN STORAGE: 


1984 23:43:25 VAX/VMS Macro v04-00 
1 Be 93:08:58 COBRTL.SRCIJCOBEXPI.MAR;1 


Word to intermediate 
Lonqword to intermediate 
Quadword to intermediate 
posting to intermediate 
Double to intermediate 
Packed to intermediate 
Intermediate to word 
Intermediate to lonqword 


; Intermediate to quadword 
; Intermediate to floating 
; Intermediate to double 
; Intermediate to packed 
; Signal -- Invalid arguments 
; Intermediate reserved operand 
; Intermediate underflow 


Intermediate overflow 
Undefined exponentiation 
Signal msg and stop 


: To define offsets of stack temps 


PIC, SHR, LONG, EXE, NOWRT 


: Temporary until Packed supported in MDL 
; Fraction field offset 
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copegxPt COBOL 
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1 
135 ; 

4 ; LoglO¢ 10%k / (10*k=1) D5 -k=1,2,.62,31 ¢ Ln 1 + 10*¢+k) ) 

1 $ TABLE1 = ish¢ 

137 .PACKED +0457574905606751254099441934852 ; +0105360515657826301227500980829 


~~" 


WOPOSOVNCHOOSs fuwwen 


~ 


44 99 40 25 51 67 60 05 49 
44 97 65 84 00 45 02 54 
65 64 30 91 76 01 74 17 


6 138 .PACKED +0043648054024500846597442222456 ; +0010050335853501441183548857556 
6 139 .PACKED +0004345117740176913064656006946 ; +0001000500333583533500142982252 
6 140 .PACKED +0000434316198075103845560440232 ; +0000100005000333358335333500013 
Q 141 .PACKED +0000043429665339013793521486461 ; +0000010000050000333335833353333 
6 142 .PACKED +0000904342946990506375442129173 ; +0000001000000500000333333583333 
? 143 .PACKED +0000000434294503617977370462100 ; +0000000100000005000000333333358 
0 144 .PACKED +0000000043429448407472425164385 ; +0000000010000000050000000333333 
6 145 .PACKED +0000000004342944821203990687473 ; +0000000001000000000500000000333 
" 146 .PACKED +0000000000434294481924966551746 ; +0000000000100000000005000000000 
6 147 .PACKED +0000000000043429448190542330006 ; +0000000000010000000000050000000 
6 148 .PACKED +0000000000004342944819034689748 ; +0000000000001000000000000500000 
6 149 .PACKED +0000000000000434294481903273542 ; +0000000000000100000000000005000 
150 .PACKED +0000000000000043429448190325399 ; +0000000000000010000000000000050 
151 .PACKED +0000000000000004342944819032518 ; +0000000000000001000000000000000 
152 .PACKED +0000000000000000434294481903251 ; +0000000000000000100000000000000 
153 .PACKED +0000000000000000043429448190325 ; +0000000000000000010000000000000 
154 .PACKED +0000000000000000004342944819032 ; +0000000000000000001000000000000 
155 .PACKED +0000000000000000000434294481903 ; +0000000000000000000100000000000 
156 .PACKED +0000000000000000000043429448190 ; +0000000000000000000010000000000 
157 .PACKED +0000000000000000000004342944819 ; +0000000000000000000001000000000 
158 .PACKED +0000000000000000000000434294481 ; +0000000000000000000000100000000 
6 159 .PACKED +0000000000000000000000043429448 ; +0000000000000000000000010000000 
6 160 .PACKED +0000000000000000000000004342944 ; +0000000000000000000000001000000 
161 .PACKED +0000000000000000000000000434294 ; +0000000000000000000000000100000 
162 .PACKED +0000000000000000000000000043429 ; +0000000000000000000000000010000 


42 72 74 40 48 94 42 43 
99 03 12 82 44 29 34 04 00 
96 24 19 48 94 42 43 00 00 
54 90 81 44 29 34 04 00 00 
03 19 48 94 42 43 00 00 00 
90 81 44 29 34 04 00 00 0 
19 48 94 42 43 00 00 00 
81 44 29 34 04 00 00 00 
48 94 42 43 00 00 00 00 90 
44 29 34 04 00 00 00 00 

94 42 43 00 00 00 00 00 
29 34 04 00 00 00 00 00 
42 43 00 00 00 00 00 00 
34 04 00 00 00 00 00 00 
43 00 00 00 00 00 00 00 
04 00 00 00 00 00 00 00 
00 00 00 00 00 00 00 00 
00 00 00 00 00 00 00 00 
00 00 00 00 00 00 00 00 


C 
37 77 79 61 03 45 29 34 Be 
0 
C 


Cmowoocr wi wr 
ASASN OA OMOMOFOnoA FS 


Se] 
SSRSASFSASVSRSFSSS=LSSSSSASNSSSUSASSSASKSVSSSRSSSNS SRS 


Sowos OO FLOLOWSO—ODOOOCOCWONSVNOWBOwWS 
SOOOCOCOSSOOOOCOOCOOOOOOOOooOoOOoOoOoooo 


ee ee ed ed ed od od od ed od OOOO OOCOO 
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03 19 48 94 42 43 00 00 
90 81 44 29 34 04 00 00 
19 48 94 42 43 00 00 00 
81 44 29 34 04 00 00 00 
48 94 42 43 00 00 00 00 
44 29 34 04 00 00 00 00 
94 42 43 00 00 00 00 00 
29 34 04 00 00 00 00 00 
42 43 00 00 00 00 00 00 


186 .PACKED +0000000000004 342944819030346804 ; +0000000000000999999999999500000 
«PACKED +0000000000000434294481903230112 ; +0000000000000099999999999995000 
188 .PACKED +0000000000000043429448190324965 ; +0000000000000009999999999999950 
189 .PACKED +0000000000000004342944819032518 ; +0000000000000001000000000000000 
190 .PACKED +0000000000000000434294481903251 ; +0000000000000000100000000000000 
191 .PACKED +000000000000000004 3429448190325 ; +0000000000000000010000000000000 
V92 PACKED #0000000000000000004 342944819032 ; +0000000000000000001000000000000 
«PACKED #00000000000000000004 34294481903 
194 PACKED +000000000000000000004 3429448190 


185 .PACKED +0000000000043429448190108035524 ; +0000000000009999999999950000000 | 
| 
| 


on 
_ 
oo 
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rx 


nenSneneneneTe 


+0000000000000000000100000000000 | 
+0000000000000000000010000000000 
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00 00 00 00 00 00 00 00 3 9 190 163 .PACKED +0000000000000000000000000004342 ; +0000000000000000000000000001000 | 
00 00 00 00 00 00 00 00 YY 186 164 .PACKED +0000000000000000000000000000434 =; +0000000000000000000000000000100 
00 00 00 00 00 00 00 00 106 165 .PACKED +0000000000000000000000000000043 ; +0000000000000000000000000000010 
00 00 00 00 00 00 00 00 06 156 166 .PACKED +0000000000000000000000000000004 =; +0000000000000000000000000000001 
00 00 00 00 00 00 00 00 $ 186 167 .PACKED +0000000000000000000000000000000 =; +0000000000006000000000000000000 | 
1F 168 
1F 19? 
1F 170 ; 
Ag Ve ; logi0¢ 1 + 10*(-k) ); k=0,1,2,...,31 : In€ 1 + 10*¢-k) ) 
s i 
1 1F 8 TABLE2 = 
38 37 21 95 11 98 63 56 $ : t 4: 174 .packed +3010299956639811952137388947245 
99 01 75 40 50 22 58 51 és 3 13 0 oY 175 .PACKED +0413926851582250407501999712422 ; +0095310179804324860043952123279 | 
| 
88 51 27 74 25 64 82 37 $ 4 .§ 8 19 176 .PACKED +0043213737826425742751881782228 ; #0009950330853168082848215357544 
21 89 66 40 86 31 79 74 hg ; 0% 8 zc 177 .PACKED +0004340774793186406689213877777 ; +0000999500333083533166809398920 
13 73 63 69 26 86 76 72 43 $3 99 i 178 .PACKED +0000434272768626696373135275851 ; +0000099995000333308335333166681 
55 68 18 53 44 10 23 29 3 O% 99 be40 179 .PACKED +0000043429231044531868554934715 ; +0000009999950000333330833353333 | 
40 56 15 56 47 26 94 42 és 00 8 3? 180 .PACKED +0000004342942647561556407439424 ; +0000000999999500000333333083333 
18 29 85 18 60 44 29 34 gs $9 181 .PACKED +0000000434294460188529180136700 ; +0000000099999995000000333333308 
94 77 31 97 47 94 42 43 99 09 4 182 .PACKED +0000000043429447973177943261133 ; +0000000009999999950000000333333 
| 
04 61 68 81 44 29 34 04 9 09 0 183 .PACKED +0000000004342944816861045868441 ; +0000000000999999999500000000333 
53 81 18 48 94 42 43 00 39 ay 184 .PACKED +0000000000434294481881537103555 ; +0000000000099999999995000000000 
10 90 81 44 29 34 04 00 33 AO 
AC 
BO 
+4 


SFSHSMSSSSSALSNSASSSISSSNSLSFSSSNSSSUSLRSSS 
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34 04 00 00 00 00 00 00 
43 00 00 00 00 00 00 00 
04 00 00 00 00 00 00 00 
00 00 00 00 00 00 00 00 

00 00 00 00 00 00 00 00 00 
00 00 00 00 00 00 00 00 

00 00 00 00 00 00 00 00 

00 00 00 00 00 00 00 00 

00 00 00 00 00 00 00 00 


00 00 00 00 00 00 00 00 
00 00 00 00 00 00 00 00 


99 99 99 99 99 99 99 99 +4 99 99 
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own AMMO 


6-SEP-1984 


«PACKED +0000000000000000000004342944819 


+0000000000000000000000434294481 
+0000000000000000000000043429448 
+0000000000000000000000004342944 
+00000000000000000000000004 34294 
+0000000000000000000000000043429 
+0000000000000000000000000004342 
+0000000000000000000000000000434 
+0000000000000000000000000000043 
+0000000000000000000000000000004 
+0000000000000000000000000000000 


packed +0 ; Temp'ry ‘til ass'bler ass'bles sh'rt p'cked const's. 


COBRTL.SRCICOBEXP! .MAR; 1 


; +0000000000000000000001000000000 
; +0000000000000000000000100000000 
; +0000000000000000000000010000000 
; +0000000000000000000000001000000 
; +0000000000000000000000000100000 
; +0000000000000000000000000010000 
; +0000000000000000000000000001000 
; +0000000000000000000000000000100 


+0000000000000000000000000000010 


; +0000000000000000000000000000001 
; +0000000000000000000000000000000 


«packed +1 
«packed +9999999999999999999999999999999 ; 31 nines 
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-SBTTL MULBIG Packed Multiply of Big numbers 


+ 
aa 


FUNCTIONAL DESCRIPTION: 


Perform a multiply of two 3l-digit packed numbers, producing a 
6S-digit ‘packed’ result. wardts : . 


CALLING SEQUENCE: 
MULBIG (MULRADDR.ap, MULDADDR.ap, PRODADDR.ap) 
INPUT PARAMETERS: 


bs a 


BDNANE WN SO OD NAME WW SO OO NAULE WO OD NAUNE WW OO OD NAME WI OWONOA UE 


FRRRRLSRRRRRRRRE 


MULRADDR.ap Address of Multiplier 
MULDADDR.ap Address of Multiplicand 
PRODADOR.ap Address of Product (32 bytes) 


IMPLICIT INPUTS: 


The multiplier and multiplicand are modified during the multiply, 
but are left unchanged at exit. Overlapping operands will produce 
incorrect results. 


; 
4 
4 
4 
oe 
04 ; IMPLICIT OUTPUTS: 
04 NONE 
4 4 
Be r oo 
04 43; ENTRY MULBIG, ameng RE -RG RG RED ; Don't want this to be global 
013¢ 4 4 MULBIG: .WORD “M<R2.R3,R4.R5,RB> 
00000 46 AS = 0 
0900001¢ 47 BS = 18 + AS 
000 4 48 C$ = 18 + BS 
900000 0 0404 249 D$ = 1 + C$ 
000003¢ 404 3 ES = 12 + D$ 
SE 3c «(C2 Geog 3 SUBL2 #&$.SP 
58 OC AC 00 407 5 MOVL  12(AP),R8 
02 AE 048C 4 36 108 : MOVP. #31,a4(AP) Bas SP) 
6E 02 AE 05 28 0411 25 mMOVC3) # -$*0+AS (SP), +A$(SP) 
AE O7 AE 05 28 0416 25 MOVCS #5. 2+5+A$(SP) .6+A$(SP) 
50 11 AE FO BF 41 5 BICBS #*KF0,5+12+A$( 
08 AE : 4 ; 6 MOVB RO, 5+ 6+A$( 
AE 4 6 6 MOVB RO, 5+ O+AS(SP) 
14 AE O8 BC 1F 346 O42A 26 MOVP. #31, a8(AP) +B$ (SP) 
12 AE 14 AE 05 8 0 26 MOVC3) # +S +B$ (SP) ,0+B$ (SP) 
18 AE 19 AE 05 436 26 MOVCS #5, 2+5+BS$ (SP) 18S (SP) 
50 23 AE FO 8 4 ¢ 6 BICBS #*XFO,5+12+BS(SP).R 
10 AE 0 ry 6 MOVE RO, 5+ 6+B$(SP) 
17 AE 90 0446 26 MOVB RO, 5+ O+BS(SP) 


B15 
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44 $9 
68 7C 044A p CLRQ (RB) 
08 A 48 7 CLRQ (RB) 
iF 1E AE 0B OC AE 08 2 72 MULP = #11,12+AS(SP),#11,12+B8S(SP),#31,16(R8) = AOxBO 
50 23 AE 11 AE 8p 73 XORB 5+12+A$(SP), 54+124B$(SP), RO 
1F AB 650) OOCtié«é8D fi BISB3 #*x0C,RO,31(R8) 
17 18 AE 0B OC AE 0B 25 76 MULP #11,124AS(SP),411, 6+BS(SP),423,C$(SP) ; AQxB1 


17 +16 AE OB O06 AE. OB 25 277 MULP #11, 6+AS(SP),#11,12+BS(SP),#23,D$(SP) ; A1xB0 


24 AE 17 3OAE 1 78 ADDP4 #23,  DS(SP),#23, _C$(SP) 
4 1A AB 90 79 MOVB +15(RB), R4 
1A A8 1f AS FO BF 8B 80 BICB3 #*XFO, 31(R8), 11415(RB) 
OF AB 17) ak AE 17-20 81 ADDP4 #23, C$(SP) #23, 15(R8) 
1A AB 8656090 Be MOVB 14+15(R8) 
17 12 AE OB OC AE, 08 84 MULP Dek. Meedncans ant, O+BS(SP).#23,C$(SP) =; AOxB2 


wnt 
o 
Por 
swmorm 
oO 
OOOQOCOCOCOOCOOOCOOOOOCOOCoOOo 


BRR RRR RRR RRR RRR RRS 


17 18 AE OB 06 AE_ 0B 


~m 
co 
w 
é 
i 
uv 


#11, 6+AS(SP) 411, 6+BS(SP),#23,D$(SP) ; A1xB1 


25 
25 
30 A 04A7 
24 AE 17 30 AE 17 20 0409 286 ADDP4 #23,  D$(SP),#23,  C$(SP) 
17 1E AE OB ES 0B 25 0480 287 MULP = #11, O+A$(SP).#11.124BS(SP) ,#23,D$(SP) ; A2xB0 
24 AE 17 30 AE 5 20 0489 288 ADDP4 #23, DS(SP), #23 C$(SP) 
4 1548 90 04C0 289 MOVB {+10¢R8), R4 
15 AS 1F AS FO BF 8B 04C4 290 BICB3 #*xXFO, 31(R8), 11410(R8) 
OA AB 17 24 AE 17 20 04CB 291 ADDP4 #23, C$(SP). “425 10(R8) 
15 a8 54 90 ve 394 MOVB 11+10(R8) 
17 12 AE 0B 06 a 25 ott 294 MULP on: 6+AS(SP),411, O0+BS(SP),423,C$(SP) ; A1lxB2 
17 18 AE 0B ES 0 25 O4E0 295 MULP =—s_« #11, OFAS(SP) #11, 6+BS(SP),#23,D$(SP) ; A2xB1 
24 AE 17 3O AE 17 20 0469 296 ADDPG #23,  DS(SP),#23, _C$(SP) 
54 10 AB «90 ~O04F0 297 MOVB {+ 5(R8), R4& 
10 A8 1F AS FO BF 8B O4F4 298 BICB3 #*xFO, 31(R8), 114 5(R8) 
05 A8 17 24 AE 17 = 20 Oar 99 ADDP4 #23, C$(SP).#23, 5(RB) 
10 a8 54 90 0502 00 MOVB 14+ 5(R8) 
17 12 AE OB 6€E : 08 25 0506 02 MULP “. O+AS(SP),#11, O+BS(SP),#23,CS(SP) ; A2xB2 
54 AS 90 050F 3 114 (RB), RS 
oe OY BER BP BR aye, op, I aR 
68 17" 24 AE 17 SiA 305 #2 C$(SP); 423" (R8) 
0B AS 54 520 06 11+ O(R8) 
524 7 
0524 308 
0525 309 


(4) 


| 


t 


ao 
of 
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FUNCTIONAL DESCRIPTION: 


Accept any two supported data types as input, convert them to 
Intermediate, exponentiate them, convert the Intermediate result 
to the data type of the output argument, and return. 


1. If routine is confronted with unknown data type it 
SIGNALSTOPs COBS_INVARG. 


2. If presented with an input CIT which has an overflowed or 
underflowed exponent field it SIGNALSTOPs COBS$_INTRESOPE. 


3. If entered at COBSEXPI_OSE (on size error) and 
exponentiation can't be done (e.g. exp < 0), returns 0. 


4. If entered at COBSEXPI and exponentiation can't be done 
it SIGNALSTOPs COB$S_UNDEXP. 


5. If exponentiation is performed and 
resulting CIT has overflowed exponent field, 
SIGNALSTOP COBS_INTEXPOVE. 
If result eon CIT has underflowed exponent field, 
SIGNALSTOP COBS$_INTEXPUND. 


NOUS WN OC OONAUES WN OOONOU ES win 


CALLING SEQUENCE: 


COBSEXPI (BASE.rx.dx, EXPONENT. rx.dx, POWER.wx.dx) 
COBSEXPI_OSE (BASE.rx.dx, EXPONENT. rx.dx, POWER.wx.dx) 


INPUT PARAMETERS: 


BASE .rx.dx The operand to the left of the operator 

EXPONENT. rx.dx The operand to the right of the operator 
IMPLICIT INPUTS: | 

NONE | 
OUTPUT PARAMETERS: 

POWER .wx.dx The power BASE ** EXPONENT 


IMPLICIT OUTPUTS: 
Different error pant ing for different entry points: 
COBSE - Call LIBSSTOP for bad exponentiation, 
COBSEXPI_OSE = Return RO = 1 or O for success or failure. 
FUNCTION VALUE: 
COBSEXPI_OSE = 1 or 0, depending on success or failure. 
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Exponentiate intermediate tempo 6-SEP- COBRTL.SRCJCOBEXPI.MAR; 1 


NONE 
QUOTES: 
“The invisible are insane."’ 
- English translation of a Chinese translation of 
an English proverb. 


“The Stone the Builders Rejected’. 
- Inscription on Jack London's gravestone. 


TET Tere re rere re rere rary 
i 
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See ane ar oe ea ra nee ee Oa =a 
PIPIPIPIPIPITIPININIPIPININININIPIFUFIND 
DV PUPV IV PUSU SUSU USES SISOS 
CDNAS WR OWOONOULS WOO 


00000000 0900 COCO C8 NI NIN NINO OO 


DCL base_it, INTSK_I_LEN ; intermediate temp 
DCL exp_it, INTSK_I_LEN ; intermediate temp 
DCL res_it, INTSK_I_LEN ; intermediate temp 
DCL x, 16 i for 3] digits 

DCL Y. 16 : for 31 digits 

DCL 32 ; for 63 digits 

DCL res_sign,1 ; sign of result 

DCL ose, ; remember entry point 
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ropes EOBSEXET ernediate Exponentiate | tempo 6-S ets 8: 8: $3 {COBRIL. SRCJCOBEXPI .MAR; 1 . (6) 
39 ERR_O: ; Base = 0 
ee 7 BO rr tte 
ex - 
"7 86 15 : ; 34 BLEQ ehh BAD . If t>0 0.0 (= base) 
: exponent > 0 return 0.0 (= base 
50 0 pO 058 3¢ MOV, | O#TCRD : 
0235 1 05 ¢ 36 BRW FINISH 
5 97 ERR_BAD: 
D 65 AE €8 0535 9 LBS ose(SP),1$ ; Br if to return status 
00000000'8F dD 0539 9 PUSHL #COBS_UNDEF_EXP 3 Undefined exponentiation 
00000000 ' GF 1 FB OS3F 400 CALLS #1,G*CIB$STOP : Signal it and quit 
0 er 276 401 1$: CLRL RO ; Error 
* O39 608 ws 
O3FC $378 404 -ENTRY COBSEXPI_OSE,“*M<R2,R3,R4,R5,R6,R7,RB,R9> 
50 01 00 0548 405 MOVL . " : Remember flavor of call 
04 11 b2ek 40 BRB 
O3FC 038 rth «ENTRY COBSEXPI ,“M<R2,R3,R4.R5.R6.R7.RB.RO> 
55 409 3; Convert to intermediate 
055 410 : 
50 D4 0552 411 CLRL- RO 
SE 00000066 8F (C2 Baee il EXP_J: SUBL2 #offset,SP 
65 AE 50 90 0558 41 MOVE = RO 0,ose($P) 
50 04 AC DO OSSF 414 MOV". 4 (AP) ,RO 
1 6 3 0563 9415 MOVAB base {ECSP) RI 
0336 3 0566 416 BSBW CONVERT 
50 O08 AC DO 0569 417 MOVL 8(AP),RO 
51 OC AE 3 056D 418 MOVAB exp it(SP),R1 
032B 3 0571 419 BSBW CONVERT 
0574 420 
0574 38421 3 
b256 re ; Compute the log base 10 of the base 
02 AE 95 0574 424 TSTB = base_it+INT$P_I_FRACT(SP) : See if base is zero 
- g307 $62 BEQL ERR_O 3 What to do? #### 
0373 : i 3 Determine the correct sign of the result 
64 AE OC 90 0579 429 MOVB #*x0C,res_sign(SP) ; Assume positive 
24 AE OB AE i? 8 B278 430 ors #*x10 gSINTSK. I_FRACT_D/2>+INTSP_ i FRACTSbose. ittsP), x (SP) 
FE66 CF 4624 AE OO 5 058 431 a) PP #1,x (SP) 
23 8 58A $36 BGEQ 1314$ 3: It is positive 
54 OC AE 3 b266 +37 “whee INTSW_I ‘sane. it(SP) ,R4 ; If exp <= 0 
590 435 ; BLEQ insteug tion changed to the BLSS instruction below, 
238 : $ ; see edit 1 
AS 19 059 4 8 iss ERR_BAD : enon espera isn't integral 
12 56 £8 059 4 ASHP R4,PINTSK_I_FRACT_D,- ook at the iractional part 
24 AE 12 00 «OE oe 59 440 INSP. I _FRACT+exp_ it(SP), #0, wintéxe 1 _FRACT_D,x(SP) 
9 1 598 441 BNEQ ERR os : ~ eanraire. then bad 
54 12 A 59D rr SUBW2 = #INTSK rig FRAC Look at the integer part 
63 01 #00 61 7 34 F 3A0 44 ASHP —s_ RG, #INT Rd FRAGT. 4 (R1),#0,81, (R3) 
04 6 4 4 5A 444 BBC #4,(R3),1314$ : If even, result is positive 
64 AE OD 0 Wg rr MOVB #*X0D, res_sign(SP) ; Else result is negative 
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itty COBSEXP! Exponent iate intermediate tempo 6-SEP 198 93:03:53 COBRTL.SRCIJCOBEXPI .MAR; 1 . 
si ret 3 begin log loop 
9 F8 AF ra: 1314$: ASHP #<30-INTSK_I_FRACT_D>,= 
581 450 #INTSK_I_FRACT_D, base_it+INTSP_I_FRACT(SP),- 
24 AE 1E b2e8 t2) #0, x (SP) 3 set x 
E OF 88 584 g BISB2 #*KOF ,15+x(SP) ; make it positive 
1D 00 63 #'I€ 4 ar F He 45 ASHP #-1,#30,(R ) ,#0,429,2 (SP) 32 <= x/1 
1F 600 ~=FE25 CF oF i rR 3¢3 454 ASHP = #<31-1>,#1,P0,#0,431,y (SP) ty <0 
56 =O gf SCF 455 MNEGL #1,R6 3k <-1 
01° 26 AE 1 302 496 2$: CMPB (SP) #1 x =i? 
1 14 Q5D 45 BGTR 3; br if x > 1 
FE10 CF 01 25 AE 1D 37 #0508 458 CMPPG #29,1+x(SP),41,P0 
38 15 QSEO 459 BEQL 38 ; br if log calculation is done 
44 AE 25 AE 48 35 bees 460 CMPPS #29,14x(SP),2(SP) 3 mez >= 1°? 
2 19 be 461 BLSS 4 : br if not 
24 AE 1F 44 AE 1D ee SEA 186 3$: SUBP4 #29,2(SP),#31,x(SP) 3 x <= x= 
1D 00 24 AE TE 36 r oor 46 ASHP —- R6 #30, x (SP) ,#0,429,2(SP) 2 <- x / 10*k 
50 56 FFFFFFFO 8F C5 OSFA 464 MULL3 #=-16,R6,R0 7k * 16 
34 AE 1F F9E8 CF40 1F 20 0602 465 ADDP4 #31, Table1C(RO],#31,y(SP) iy <= y + Logl 10*k/(10%k-1) ) 
CS 3611 0608 466 BRB 2s 
56 D7 0600 467 4$: DECL R6 k <= k+l 
1D 00 24 AE 1E 4 rt F8 pee 468 ASHP R6,430,x (SP) ,40,429,2(SP) z<-2z/ 10 
BB 12 0618 469 BNEQ 2$ ; finished if k gets very large 
061A 470 108: 
061A 471; 
061A 472; end log loop 
O61A 473; 
O61A 474 ée 00...0+ <= y <= 99...9+ 
061A 475 
061A 476 ; E_d is the number of extra Gigite we need for the exponent, 
O61A 477 ; rounded up to the nearest multiple of 2. 
061A 478 
00000002 + 8h 479 E_d = 2 
61A 480 LIF GE, INTSK_I_EXP_HI-100, E.d=4 
61A $8) lif ug TL 5 Be 2a tah E.d=4 
61A 4 é TIIF © GE. INTSK71 “EXP7H1-10060, E“d = 6 
aia ret olIF LT, INTSK_I_EXP_LO+10000, E_d = 6 
61A 485; 00...0+ <= y < 99...9% 
61A £88 
61A 487 ; ‘ 
ota +38 3 begin multiply by exponent 
34 AE 1F FDD3 CF IF § 61A 490 © SUBP4 #31 ,NINES,#31,y(SP) ; Subtract one (essentially) 
50 oF 6 g 491 CVTWL INTSW_I pet |) eiadanathdhaaie ; need to add this on 
44 AE 83 F 6 136 CVTLP pi #E-d¥1 ,2(SP) 
1F 00 44 AE ~ ip FB 6 A 49 ASHP = #3 1-E“d ,#E_d+1,2(SP) ,#0,#31,x<SP) 
42 AE OF A 06 ; 494 BICB #*XOF ,15-<E_d/2>+y(SP) ; Move sign closer in y 
42 AE OD | 6 495 B1SB #*X0D,15-<E_d/2>+y(SP) ; Remember it's reget tye now 
24 AE 1F 34 AE 10 big £38 ADOP #31-E_d,y(SP) ,#31,x(SP) 3 x <= y + exponent - 1 
064 498 


~= 
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1-01 COBSEXPI Exponentiate intermediate oes ae P-19 8 (CCOBRTL.SRCJCOBEXPI.MAR;1 (6) 
9 FB 064 499 ASHP #3i- K_I_ FRACT_D 
AE #INT rt “PRACT. 5 INF SP. I_FRACT+exp_it(SP),- 
34 AE IF OO ; #31-yTSP) 
44 AE OF PUSHAB 2+0(5P5 : 
38 A a PUSHAB y+4(SP) 3 tthis” is any z needs 63 digs) 
A F PUSHAB x+#8(SP) 
FDAS CF 0 S$ #3,MULBIG 


-099.9999 <2z2< +099.9999 
end multiply by exponent 
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COBSE XP COB 
ett CoB 
44 AE if 33 00 
03 Dd 
18 14 
50 1 A046 9 
2¢ 7 H cS 
24 AE 07 00 6 0 ; 4 
FEBS 3 
28 AE 03 Al 
03 Al 63 AE FO 8F 
AE 61. 07 & 
03 Al 28 AE 0 
5 C AE 2 
50 BE A644 ; 
07 O00 24 AE 50. CF 
8A 
St 
51 28 AE QO 36 
18 AE 51 «=F? 
c8 1D 
7” FY OE 
54 57 FF 8F 7 
10 4 0D 
03 15 
54 10 00 
50 
50 57 54 
1F 00 44 AE44 


63 AE FO 
23 AE4S 
53 AES4 
FFFFFFFE 
1F 
a 
1 
1 
0 
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12; 
15; We want to grab the integer and fractional ports of this product. 
13 ; Unfortunately, the VAX does not (yet) support 635 digit packed numbers. 
1 e 
9 SKPC #0,431,2(SP) : Skip Leading zeroes 
18 mov | RO,R4 ; Save # of bytes remaining 
1 cmol RO,#3 ; Do we have at least 7 digits? 
0 bgtr 10618 : Branch if so 
1 mova £50) CRgI.RO : # of digits in product 
§ subl RO,#7,R ; Calculate shift amount 
ashp R + a teat catia :; Shift exponent into x 
4 brb 1062 ; Merge with other case 
lad RR_BA 3; Branch point 
5 9191$: BR BAD i 
§ 1001$: movb (RT) ,44x (SP) 3; Save these digs a moment 
bicb3 #*XxXF0,31+2(SP),3(R1) ; Put in the correct sign 
8 mov #7, (R1), x (SP) 3; The exponent’s hidden in here 
3 10028 mov 4+x(SP),3(R1) ; Restore digits 
1 CVTWLSCOAINTSW_I ett iy Oh alae ; Get the exponent's exponent 
3 MOVAW aGbsE dTRG) ERS RO ; Calculate shift amount (!) 
3 ASHP RO,#7,x(SP) ,#0,47,4+x (SP) 
34 BVS 9191$ : Exponent overflow #### 
§ 1006S: CVTPL #7,4+x(SP),R1 4 
: CVTILW «RIT, INTSW_I_EXP+res_it(SP) 
f BVS 9191$ 
i 3 The decimal point is E_d+1+R6 places to the right of z 
41 CLRL RG 
$5 MOVAB E_d+1(R6),R7 
4 BLEQ 1010$ : R4 is correct offset from 2(SP) 
ah ASHL #-1,R7,R4 
45 CMPL R 
+8 BLEQ 1010$ ; R4 is correct offset from 2(SP) 
4 MOVL #16,R4 ; R4 is correct offset from 2(SP) 
re 1010$ 
39 3 Shift by E_d + 1+ R6 = 2#R4 = R7 - 2#RG 
26 BICB3) 3 #*xF0,31+z(SP) ,RO ; Put in a correct sign 
5 BICB #*XOF ,154+2(SP)LR4J 
4 BISB RO,15 ay? 
5 EMUL  #-2,R4,R7,R ; R7 - 2% RS 
6 ASHP RO, #31.2($P)CR4),#0,431,x(SP) ; Shift into x 
57 GEQ sgi"s : >= 0.7? D'lovely. 
28 ADDP4 #31 brit pete x (SP) 3; Add 1.0 
ADDPS = #1,P1,#31.x(SP) 
60 seats DECW —INTSW_1_EXP+res_it(SP) ; Decrease result's exponent 
62 
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itt EOBSEXET Exponentiate intermediate tempo Patios 7 93:28:58 YCOBR TL. SRETCOMEXPS MARS 1 ° (8) | 
FE 64 ; 
ert 6g : begin exponentiate loop 
oF 6 ; #00000 <= x <= +99999 
iF 00 FCED CF n.. b 8 i 8 ASHP #29,81,P1,#0,431,y(SP) zy <- 1 
56 D4 4s 70 CLRL R6 ik <- 0 
54 56 FFFFFFFO BF 5 70A 71 °11$ MULL #-16,R6,R4 
24 AE «FADE CF 44 IF ; tle te cpp #31, fable2[R43,x(SP) ; log(1#10*l-k)) > x ? 
1F 00 34 AE wo 28 F8 738 74 ASHP R6,#31,y (SP) ,#0,431,2(SP) zy <- y + 10*(-k)y 
, oh 7 75 BEQL 208 
34 AE 1F 44 AE 1F 727 76 ADDPG = #31,2(SP) ,#31,y(SP) 
24 AE 3O1F OF ABC CF44 4 ‘ fi 3 oe = #31 TablectRss.a 1,x(SP) 3 x <= x = bog(1#10*(-k)) | 
4 7 0739 8 12$: DECL R6 pk <k 41 
FCAD CF 01 26 AE IF 7 07 80 CMPPG = =#31,x(SP),#1,P0 : if w = 0 then exitloop 
CS «612 «(074 81 BNEQ 11$ 
074 288 20S: 
F4 BF F8 Boe 58 ASHP #INTSK_1_FRACT_D-30,- ; Shift into result 
34 AE 1F 748 584 #31,y(SP),- 
01 0748 585 #1,- : (rounded ever so slightly) 
12 074C 586 #INTSK_I_FRACT_D,- 
1A AE gree ef? NTSP_T_FRACT+res_it(SP) 
06 1¢ 74F 88 BVC 1 
63 01 90 0751 589 MOVB #18<4*<18INTSK_I_FRACT_D>>,(R3) ; Means answer = 1 
18 AE 66 37 38 eae INCW INTSW_I_EXP+res_7t(SP) : Increment exponent (#1) 
18 AE 86 0757 236 21$: INCW INTSW_I_EXP+res_it(SP) ; Increment exponent (#2) 
073A 394 : Put in the correct sign 
23 AE OF 8A O75A 596 61082 #*XOF , INTSK 1_FRACT_D/2+INTSP_I_FRACT+res_it(SP) 
23 AE 64 AE 88 aoe an BISB2 res_sign(SP),INTSK_T_FRACT_D/2+INTSP_I_FRACT+res_it(SP) 
B78 298 3 
76 600 ; end exponentiate loop 
076 601 ; 
5E 18 AE 9E th O06 MOVAB res_it(SP),SP ; B.O.H.1. , 
50 01 00 6 60 MOVL #1,R 3 Success. Exaltation. 
076A 604 ; Baw FINISH 
gk ae 
Ben g09 t ALL done with the hard part. Now fall through and convert to destination. 
076A 609 ° 
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itty FINISH Convert to dest ination type and Pama 1 93:08:58 YCOBRTL. SREICOBEXP] MAR: 1 (9) 
Poa ele -SBTTL FINISH Convert to destination type and return 
76A 15 3+ 
76A gi 3 Enter by branch with (SP) containing the intermediate result 
76A 615 ; and 12(AP) pointing to the descriptor for the destination. 
76A o1$ : RO contains routine status 
fea bl 
76A $19 FINISH: 
02 a %3 fon ° 9 [sts [gFeP 1 FRAC TCSP : is fraction zero ? 
3 no 
—E 64 O76F 6 ¢ CLRW AUTOM, 1 EXPCSP) 3: force exponent to zero 
we. Se BRB $ 3 ayeess overflow and underflow 
o77 ° : 3 ; checks 
077 6 § ; Check for out-of-range conditions first 
or? 627 ; We do the check here for all destination type so that we can report 
77 628 ; overflow and underflow distinctly. If we allow the flow to go 
077 629 ; directly to various COBSCVTI_x routines, what will be reported 
077 650 ; is COBS_INTRESOPE (which is not correct -- we just created the 
077 631 ; exception and did not access it -- creating an exception should 
077 6 § 3 distinguish between over_ and under_flow) 
077 633 ;- 
Sr BE a 
0063 8F of B1 077 636 CMPW NTSW_I_EXP(SP), #INTSK_I_EXP_HI ; Bigger than max ? 
5 14 0778 637 BGTR $ : Yes, overflow 
FFOD 8F 6€ B81 O77A 638 CMPW JNTSW_1_EXP(SP), #INTSK_I_EXP_LO ; Less than min ? 
56 619 149 o73 98 BLSS $ : Yes, underflow 
50 ODD $781 641 PUSHL RO ; Save success status 
tht 4 ; Result now at 4(SP) 
50 OC AC DO 0783 644 MOVL 12(AP) ,RO 
1F 00 02 Ad of 787 = 645 CASEB DSCSB_DTYPE(RO) 40,431 
0202° 078C 646 108: -WORD BAD_DT-10$ 3s @2 
os8 * 078 647 «WORD BAD_DT-10$ ; iF 
0202" 079 648 eWORD BAD_DT-10$ 3 ¢ BU 
8s8 * 079 649 -WORD BAD_DT-10$ : WU 
02° 0794 650 -WORD BAD_DT-10$ ; 4LU 
0202' 079 651 -WORD BAD_DT-10$ :; 5 QU 
02° 079 $36 - WORD AD_OT-10$ ; 66 
58° 079A 65 «WORD 0$-10$ :; 7 WwW 
Boe * 079C $38 - WORD $-10$ 3 8 L 
9A° 079 55 -WORD 40$-10$ 3 Q 
00BB' 07A $26 - WORD 203-138 : 10 F 
OOCD’ O7A 65 -WORD 608-108 : 110 
0202° O7A4 $28 -WORD BAD_DT-10$ 3 1 FC 
3 02° O7A 65 -WORD BAD_DT-10$ ; 135 OC 
02° O7A 660 -WORD BAD_DT-10$ 3: 147T 
02° O7AA 661 -WORD BAD_DT-10$ 3; 15 NU 
02° O7AC 666 -WORD BAD_DT-10$ 3 18 NL 
3 * O7A 6 . BAD_DT-10$ 3 3 mo 
* 078 664 ‘ BAD_DT-10$ 3 18 
05" Oye bb "WORD BADTBT=108 £30 No” 
DF* 0786 ; ow FOST 108 ; 5 e 
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et FINISH Convert to dest ination type and g-8E p=] 986 93:08:58 COBRTL.SRCICOBEXPI .MAR; 1 - ( 
* 0788 6 «WORD BAD_DT-10$ $ I 
* O7BA es -WORD BAD-DT-10$ : § en 
* 07BC ? «WORD BAD_DT-10$ 3: 246 OSC 
* 078 7 «WORD BAD_DT-10$ : 25 OU 
oe 145 a 24 WORD BAD DT=10$ : $6 0 
7¢ 67 «WORD BAD_DT-10$ 3 G 
* o7¢ 674 WORD BAD_DT-10$ ; 28H 
. ree 675 «WORD BAD_DT-10$ 3; 29 GC 
* O7C¢ 976 «WORD BA OTS $ ; 50 HC 
° ‘ O7CA 67 .WO 0$-10$ : 31 COBOL intermediate data type 
01BF 1 7CC o78 BRW BAD_DT 
7CF 4 
7CF 0 3+ 
7CF «=: 81 —«s:—«CCIT overflowed. 
7CF 66 ¢ _- 
7CF 6683. 85: 
00000000 ' 8F 0D gece 684 PUSHL #COBS_INTEXPOVE ; Overflow signal 
06 11 #O7D5 685 BRB 6$ 3; go signal 
0707 686 
0707 687 ;+ 
{3 688 ; CIT underflow 
707 =689 ;- 
0707 690 5s: 
00000000°SF DD O7D7 691 PUSHL #COB$_INTEXPUND 3; Underflow signal 
00000000'GF 01 FB A 4 $2 6$: CALLS #1,G*CIBSSTOP : Signal and stop. 
O7E4 694 3+ 
O7E4 695 ; Destination is W 
O7E4 696 ;- 
56 04 O7E4 697 30S: CLRL R6 ; Assume class S$ 
09 O3A0 91 4 4, 698 CMPB DSCS$B_CLASS(RO) ,ADSCSK_CLASS_SD 
07 iF O7EA 699 BNEQ 21$ : Branch if not class SD 
56 08 AO 98 O7EC 700 CVTBL DSCSB_SCALE(RO) ,R6 ; Get scale factor 
56 56 CE O7F 701 MNEGL ‘R6,R6 3; Negate scale factor 
57 O4A a 7F 702 218: MOVAB 4(SP),R7 3; Get source address 
58 O04 A D 7F 70 MOVL DSCSA_POINTER(RO) RB ; Get destination address 
00000000'GF 16 O7FB 704 JSB G*COBSCVTIW_R8 : Go to conversion routine 
50 8€ DO 0801 £705 MOVL (SP)+,RO 3; Restore status 
04 0804 70 RET ; Return 
805 70 
805 708 ;+ 
33 A 3; Destination is L 
56 D4 03 711 $08: CLRL R6 3; Assume class S 
09 O3A0 91 0 ar CMPB RCS8_CLASS (RO) .#DSCSK_CLASS SD 
Me ok 0B 71 NEQ 1$ ; Branch if not class SD 
56 UWB AO 9 0D 714 CVTBL DSCSB_SCALE(RO),R6 ; Get scale factor 
56 E 110 715 MNEGL R6,R6 : Negate scale factor 
22 04 Af 14 £18 31$: MOVA 4(§P) ,R7 ; Get source address 
D 18 71 MOVL DSCSA_POINTER(RO) ,R8 : Get destination address 
00000000 ' GF 16 1 8 JSB G*COBSCVTIL_R8 : Go to conversion routine 
50 4 71 MOVL (SP)+,RO -: Restore status 
720 RET 3 Return 
6 721 
oe § i+ : A 
? 4 ? 3 Destination is Q 
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1 FINISH Convert to destination type and 6-S 74 COBRTL. SR €3c08 OBEXPI.MAR;1 (9) | 


5 ps § 5 40S: CLRAL R6 3; Assume class S$ 
09 O3 A 1 § CMPB ps¢sB_ CLASS(RO) ,#DSCSK aCLASS_ SD 
0 1 BNEQ 4 3; Branch if not class SD 
56 se” $0 : 8 og pote. SCALE (RO) ,R6 3 Get negative of scale factor 
7 A i S| 0 41$: VAB reeRs R7 : Get source address 
8 A D 1 VL DSeSA, POINTER(ROD R8 3; Get destination address 
: 1 4 7 ¢ JSB 6*CO bescy TIQ_R8 3; Go to conversion routine 
E 4 4 7 MOVL (SP)+,R 3; Restore status 
$8 734 RET 3; Return 
et 
3* 
Be? $ 3 Destination is F 
3$ 9% . oe 47 5 3 Sos MOVAB 4(SP),R6 ; Get source address 
A ») 48 740 MOVL DSCSA_POINTER(RO) ,27 ; Get destination address 
‘¢ 16 4F = 741 JSB G*COBSCVTIF_R7 ; Go to conversion routine 
50 — oO 55 7% MOVL (SP)+,RO0 3; Restore status 
06 0858 74 RET 3 Return 
ae 
322 rs 3 Destination is D 
56 046 AE 3 $B59 748 60S: MOVAB 4(SP),R6 ; Get source address 
57 04 A0 00 O85D 749 MOVL DSCS$A_POINTER(RO) ,R7 3; Get destination address 
00000000°GF 16 0861 750 JSB G*COBSCVTID_R7 ; Go to conversion routine 
50 8€ 00 0867 751 MOVL (SP)+,R0 3; Restore status 
04 086A P3¢ RET 3; Return 
ae 
Bae8 £3 3; Destination is P 
5 D4 0868 Fas 70S: CLRL R6 : Assume class S$ 
09 O3 Ad 91 9360 758 CMPB SCS$B_CLASS(RO) ,ADSCSK CLASS_ SD 
0 ‘ 38 1 2 BNEQ $ 3: Branch if not class SD 
a3 760 CVTBL DSCS$B_SCALE(RO),R6 ; Get negative of scale factor 
087 761 MNEGL R6,R6™ 3 
87A 762 71%:  MOVA (§P) ,R7 : Get source address 
87E 76 MOVZWL BscSu. of SHG THIRD? R8 : Get destination length 
$81 764 MOVL DSCSA~POINTER(RO).R9 =: Get destination address 
5 765 JSB Bee oeScTIP P_R9 3; Go to conversion routine 
; 76 MOVL (SP)+,RO ; Restore status 
O88E 76 RET 3; Return 
ar 
: 770 : Destination is intermediate 
F ore bos: MOVL $A =POINTERCROD . RO : Get destination address 
33 77 mova »>(RO)+ 3; Move 8 bytes 
9 774 3; Move 4 are bytes 
98 775 3; Restore status 
9E £76 3; Return 
9F 777; 
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79 -SBTTL CONVERT Internal routine to convert to intermediate 
i se 
§ 3 catl by JSB 
3 RO points to descriptor (class = $ or SD) 
4; R1 points to output area (12 bytes) 
oe 
7 $ CONVERT: 
1F 00 02 A0 _ &F 7 CASEB DSCSB_DTYPE(RO),#0,431 =; Go to proper conversion code 
EA‘ 789 108: WORD BAD_DT-10$ . |Z 
EA’ 7 9 -WORD BAD"DT-10$ : 1V 
EA‘ 79 WORD BAD_DT-10$ 3 § BU 
EA’ 79 .WORD BAD-DT-10$ ; 3 Wu 
OEA* AC 79 «WORD BAD_DT-10$ : 4LU 
EA’ O8AE 794 -WORD BAD"DT-10$ : 5 QU 
EA’ 088 795 -WORD AD_DT-10$ 3 § 8 
3° 088 79 WORD $-10$ 3 W 
ts 88 79 - WORD $-10$ s; Ot 
4 ° 44 798 -WORD 40$-10$ ; 90 
8E* 088 799 eWORD 50$-10$ : 10 F 
0098° O8BA 00 -WORD 608-108 3: 110 
QOEA’* 08BC 01 «WORD BAD_DT-10$ 5 \¢ FC 
OOEA’ 088 0¢ ~WORD BAD"DT-10$ : 13 0¢ 
OOEA' ac 0 -WORD BAD"DT-10$ 7147 
OOEA" O8C 04 «WORD BAD_DT-10$ ; 15 NU 
QOEA’ O08C 05 -WORD BAD_DT-10$ ; 16 NL 
OOEA’ ac6 36 -WORD BAD_DT-10$ : 17 NLO 
OOEA’ 08C 0 -WORD BAD"DT-10$ : 18 NR 
OQOEA’ CA 08 -WORD BAD_DT-10$ 3; 19 NRO 
QOEA’ O8CC 09 a AD_DT-10$ : 20 NZ 
AB" O8C 10 WORD 0$-10$ 3: 21 P 
OEA* D 11 ‘ D BAD_DT-10$ 2 § ZI 
QOEA’ 08D \¢ -WORD BAD_DT-10$ 3 ZEM 
QOEA’ D4 1 ‘ D BAD_DT-10$ 3: 24 DSC 
QOEA' D6 14 2 D BAD_DT-10$ 3; 25 OU 
EA‘ 08D8 815 -WORD BAD"DT-10$ ; 260 
EA’ O8DA 16 -WORD BAD"DT-10$ 3 27 G 
EA‘ O8DC 81 ; BAD-DT-10$ ; 28H 
OEA* 18 -WORD BAD_DT-10$ : 29 GC 
EA’ O8E 1 -WORD BAD"DT-108 > 30 HC 
gs" E 0 WORD 0$-10$ : 31 COBOL intermediate data type 
00A7 1 O8E4 1 BRwW BAD_DT 
eb BSS 
E7 4 ; Source is W 
E7 5 
56 ps £7 6 20$: CLRL R6 : Assume class S 
09 03 Ad 1 E9 CMPB SCSB_CLASS(RO) ,ADSCSK_CLASS_SD 
06 = 1 ED 8 BNEQ 1$ : Branch if not class SD 
§ 8 A 9 EF CVTBL DSCSB_SCALE(RO) ,R6 ; Get scale factor 
A D 3 0 21$: MOVL DSCSA-POINTER(RO) ,R7 ; Get source address 
58 51 » F 1 MOVL R1,R8 3; Get destination address 
00000000 ' GF FA § JMP G*COBSCVTWI_RB 3; Go to conversion routine 
$09 4 3+ 
9 5 ; Source is L 


cose xP] a Tg ed Exponentiate nde 15S ats 93:08:53 AX/VMS Mac 
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CONV Internal routine to convert to  6-SEP-1984 sae (38) 


ro V 
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5 4 Sos: CLRL R6 ; Assume class $ 
09 «86203 Fi 5 3 CMPB a temeeabantene eo 
ee | BNEQ 3; Branch if not class SD 
29 6 - 9 re CVTBL DSCSB_SCALE(RO) ,R6 ; Get scale factor 
AOD 41 318 MOVL DSCSATPOINTER(RO),R7 ; Get source address 
. oe tg MOVL R1,R8 3; Get destination address 
_ 2 9 JMP G*COBSCVTLI_RS 3; Go to conversion routine 
9 re: * 
, 46 ; Source is Q 
56 ps 9 48 408: CLRL = aR ; Assume class $ 
09 03 Ad 1 9 CMPB DSCSB_CLASS(RO) ,ADSCS$K_CLASS_SD 
06 = «1 9 BNEQ 41$ 3 Branch if not class SD 
38 98 Ap 9 CVTBL ODSCS$B_SCALE(RO) ,R6 3; Get scale factor 
AOD 41$:  MOVL  DSCSATPOINTER(RO),R7?7 =; Get source address 
58 51 oO MOVL R1,R8 3; Get destination address 
00000000'GF 1 JMP G*COBSCVTQI_R8 ; Go to conversion routine 


g¢ 
3; Source is F 


56 04 AO S0$: MOVL  DSCSA_POINTER(RO).R6 =; Get source address 
57 MOVL eR? 3 Get destination address 
00000000 ° GF JMP G*COBSCVTFI_R7 ; Go to conversion routine 


PARA APLXAPEQXPEMAAAA III & 


UEWN SO OONOAOUES WN O OONO 


3+ 
3; Source is D 


“ 
os 
—-o9 
Noo 
SSSSSSSSSSSSSSSSODO DODO OD 


PP SF ARNNNN GGA I IIIT PIAA AE 
DOWLMNMMO OOOO OUT TNH OPINION OU "DOOOODOWO™ 


PAAR ES BS BE EEE EMA. AN AAAI AIAIOIIID OO O  * 


56 04 A0 00 66 60S: MOVL DSCSA_POINTER(RO) ,R6 :; Get source address 
57 +3 67 MOVL 3; Get destination address 
00000000°GF 1 of JMP G*COBSCVTDI_R7 3; Go to conversion routine 
70 ;+ 
4 ; Source is P 
564 tg 70S: CLRL = R6 : Assume class $ 
09 03 Ad 1 74 CMPB DSCS$B_CLASS(RO) ,ADSCSK_CLASS_SD 
06 =#«1 75 BNEQ ‘1$ : Branch if not class SD 
56 08 AO 9 26 CVTBL DSCSB_SCALE(RO) ,R6 ; Get scale factor 
7 60 3 77 71$: MOVZWL DSCSWTLENGTH(ROS ,R7 : Get source Length 
58 04 A0 00 28 MOVL  DSCSATPOINTER(ROS,R8 § ; Get source address 
59 $1 09 F 7 MOVL R1,R9 3; Get destination address 
00000000 ' GF 39 JMP G*COBSCVTPI_R9 ; Go to conversion routine 
34 
$ : Source is intermediate 
50 04 ag DO 5 80S:  MOVL  DSCSA_POINTER(RO),RO =; Get source address 
0063 8F 60 81 096C 6 CMP NTSW71_EXP(RO), #INTSK_I_EXP_HI ; Bigger than max ? 
0 14 0971 BGTR 1 : Yes, overflow 
FFOD BF 8! 97 8 CMPW JNISu_1_EXP(ROD, #INTSK_I_EXP_LO ; Less than min ? 
9 097 9 BLSS 1$ ; Yes, underflow 
81 80 7D O97A 0 MOVa  (RO)+,(R1)¢ : Copy 8 bytes 
61 60 p 97 91 MOVL (RO), ¢R1) : Copy 4 more bytes 
98 92 RSB : Done 
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00000000 ° 8F 
00000000 ° GF 1 


00000000 ' 8F 
00000000°GF 01 


COBO jn 
CONVER 


DD 
FB 


wo 


woo 
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ooo 
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00 Oc 


ermediate Exponentiate 2-3 -1 
Internal routine to convert to 6=SEP-1 
E 
T 


93 818: 
94 


PUSHL 
CALLS 


1 


SOPE 


#COBS_ 1 
I oP 


NTR 
#1,G*CIBS$S 


9 
9 


Be 10: 


95 
38 3+ 
2 ; Here if not a supported data type. 


99 BAD_DT: PUSHL 
0 CALLS 


«END 


#COB$_INVARG 
#1,G*CIBSSTOP 


43:53 AX/VMS Macro V04-00 
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3; Intermediate reserved operand 
; Signal the error 


; "Invalid argument List"’ 


p 1 
oe 5)) 


COBSE XP i 
Symbol table 


AS 


= INVARG 
COBS_ UNDEF _EXP 
ONVERT 


os 
DSCSA_POINTER 
$s CLASS 


Oo *"OOCOOOCOOoOoOSoSoSoSo 
So *"OOOOOCSOOOOoOSoSoSo 


0990012 


2009008 © 


RRRRHEEE 
RERKeEHe 
(Ae SAAS SD | 
RReRREAE 
REREREKE 
RRREKEKE 
RERKREEE 
Reeeeeee 
RRRERRRE 
REARERERE 
RREERREEE 
RREARERE 


00000550 RG 
00000549 RG 


REAEREEL 
RERRRARE 
ReReeene 
Reet 
RRERRRERE 


00000004 


oOo 


MOH HBH— WHMAAHYMO # OOO OO COMOWNWOOSCSOoS 


FOOL W—OMVIOMNIP # QMONIWPNMLEOUUINM OOocorw 
a 2D DD 


RNOOOOCOOCOOOOSoSo 
RNOOOCOCSCOSOSOSoSoSSSO 
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COBOL Intermediate 


02 


SOOQOoooooooooooooooCoo 
NVNOCOCOCONMNGOOOCOCCOOCOSoOCoOoO 


Exponentiate 
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AX/VMS Macro 
COBRTL.SRCICO 


v0 
BE 


bo 


0 
XPI.MAR; 1 


Paar 45) 


COBSE XP] 
Psect synopsis 


PSECT name 


ABS . 
SABS$ 
_COBSCODE 


Initialization 
Command processing 


Pass 

Symbol table sort 
Pass 2 

Symbol table output 
Psect synopsis output 


Cross-reference output 
Assembler run totals 


Macro Library name 


$255SDUA 
TOTALS (all libraries) 


D 16 
COBOL Intermediate Exponentiate iF a ads 9 $34 
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! Psect synopsis ! 


fee cto eatoswmonrwoca + 


Allocation PSECT No. Attributes 

00000000 <¢ 8} 00 ¢ 0.) NOPIC USR CON’ ABS 
00000000 ( -) QO1¢ +1.) NOPIC USR CON ABS 
0000099B ( 2459.) 02 ¢ 2.) PIC USR CON” REL 


pProwostece eeeseeeweceeece waoaa $f 


! Performance indicators ! 


peewee woman nnease soe scene nece + 


CPU Time Elapsed Time 

33 00:00:00.04 00:00:01.74 
123 00:00:00.41 00:00: $°28 
190 00:00:02.87 00:00:13.45 
0 00:00:00.17 00:00:00.85 
174 00:00:01.43 00:00:04.60 
9 Ss Sha 00:00:00.06 

3 00:00:00.02 00:00:00.05 
0 00:00:00.00 00:00:00.00 
534 00:00:04.98 00:00:24.28 


The working set Limit was 1350 pages. 

27182 bytes (54 pages) of virtual memory were used to buffer the intermediate cod 
There were 20 pages of symbol table space allocated to hold 189 non-local and 4 
2 source lines were read in Pass 1, producing 22 object records in Pass 2. 

10 pages of virtual memory were used to define 9 macros. 


+ + 
H Macro Library statistics ! 


emer eceeen eee em ewer eee enm ene se} 


Macros defined 


“ESE ZEDUACE: ECOORTL 08) 3COBRTL MLB; 1 1 
:CSYSLIBISTARLET.MLB;2 4 
203 GETS were required to define 5 macros. 

There were no errors, warnings or information messages. 
MACRO/ENABLE=SUPPRE SS1ON/DI SABLE=(GLOBAL , TRACEBACK) /LIS=LIS$:COBEXP1/OBJ=OBJ$:COBEXPI MSRC$:COBEXPI/UPDATE=(ENH$: COBEXP!) +L 1B$:COBRT 
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ro V04-00 
COBRTL.SRCJCOBEXPI .MAR; 1 


22 
o 
nom 
== 
zDD 
2 
o 


EXE NORD NOWRT NOVEC BYTE 
axe RD WRT NOVEC BYTE 


SHR RD NOWRT NOVEC LONG 


e. 
6 local symbols. 
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